home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tm / gnus-art-mime.el.z / gnus-art-mime.el
Encoding:
Text File  |  1998-05-21  |  4.7 KB  |  175 lines

  1. ;;; gnus-art-mime.el --- MIME extension for article mode of Gnus
  2.  
  3. ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Created: 1996/8/6
  7. ;; Version:
  8. ;;    $Id: gnus-art-mime.el,v 0.10 1997/01/29 08:24:01 morioka Exp $
  9. ;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  10.  
  11. ;; This file is not part of GNU Emacs yet.
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 2, or (at
  16. ;; your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;;; Code:
  29.  
  30. (require 'emu)
  31. (require 'gnus-mime)
  32. (require 'gnus-art)
  33. (require 'tm-view)
  34.  
  35. (autoload 'mime-eword/decode-region "tm-ew-d"
  36.   "Decode MIME encoded-words in region." t)
  37. (autoload 'mime/decode-message-header "tm-ew-d"
  38.   "Decode MIME encoded-words in message header." t)
  39.  
  40.  
  41. ;;; @ encoded-word
  42. ;;;
  43.  
  44. ;;; `gnus-decode-rfc1522' of Gnus works only Q-encoded iso-8859-1
  45. ;;; encoded-words.  In addition, it does not apply decoding rule of
  46. ;;; RFC 1522 and it does not do unfolding.  So gnus-mime defines own
  47. ;;; function using tm-ew-d.
  48.  
  49. (defun gnus-decode-encoded-word ()
  50.   (goto-char (point-min))
  51.   (if (re-search-forward "^[0-9]+\t" nil t)
  52.       (progn
  53.     (goto-char (point-min))
  54.     ;; for XOVER
  55.     (while (re-search-forward "^[0-9]+\t\\([^\t]+\\)\t" nil t)
  56.       (mime-eword/decode-region (match-beginning 1) (match-end 1)
  57.                     'unfolding 'must-unfold)
  58.       (if (re-search-forward "[^\t]+" nil t)
  59.           (mime-eword/decode-region (match-beginning 0)(match-end 0)
  60.                     'unfolding 'must-unfold)
  61.         )
  62.       ))
  63.     (mime-eword/decode-region (point-min)(point-max) t)
  64.     ))
  65.  
  66. (defalias 'gnus-decode-rfc1522 'gnus-decode-encoded-word)
  67.  
  68. ;; In addition, latest RFC about encoded-word is RFC 2047. (^_^;
  69.  
  70.  
  71. ;;; @ article filter
  72. ;;;
  73.  
  74. (defun gnus-article-preview-mime-message ()
  75.   (make-local-variable 'tm:mother-button-dispatcher)
  76.   (setq tm:mother-button-dispatcher
  77.     (function gnus-article-push-button))
  78.   (let ((mime-viewer/ignored-field-regexp "^:$")
  79.     (default-mime-charset
  80.       (save-excursion
  81.         (set-buffer gnus-summary-buffer)
  82.         default-mime-charset))
  83.     )
  84.     (save-window-excursion
  85.       (mime/viewer-mode nil nil nil gnus-original-article-buffer
  86.             gnus-article-buffer
  87.             gnus-article-mode-map)
  88.       ))
  89.   (run-hooks 'tm-gnus/article-prepare-hook)
  90.   )
  91.  
  92. (defun gnus-article-decode-encoded-word ()
  93.   (decode-mime-charset-region (point-min)(point-max)
  94.                   (save-excursion
  95.                 (set-buffer gnus-summary-buffer)
  96.                 default-mime-charset))
  97.   (mime/decode-message-header)
  98.   (run-hooks 'tm-gnus/article-prepare-hook)
  99.   )
  100.  
  101.  
  102. ;;; @ for tm-view
  103. ;;;
  104.  
  105. (defun gnus-content-header-filter ()
  106.   (goto-char (point-min))
  107.   (mime-preview/cut-header)
  108.   (decode-mime-charset-region (point-min)(point-max) default-mime-charset)
  109.   (mime/decode-message-header)
  110.   )
  111.  
  112. (defun mime-viewer/quitting-method-for-gnus ()
  113.   (if (not gnus-show-mime)
  114.       (mime-viewer/kill-buffer))
  115.   (delete-other-windows)
  116.   (gnus-article-show-summary)
  117.   (if (or (not gnus-show-mime)
  118.       (null gnus-have-all-headers))
  119.       (gnus-summary-select-article nil t)
  120.     ))
  121.  
  122. (call-after-loaded
  123.  'tm-view
  124.  (lambda ()
  125.    (set-alist 'mime-viewer/content-header-filter-alist
  126.           'gnus-original-article-mode
  127.           (function gnus-content-header-filter))
  128.    
  129.    (set-alist 'mime-viewer/code-converter-alist
  130.           'gnus-original-article-mode
  131.           (function mime-charset/decode-buffer))
  132.    
  133.    (set-alist 'mime-viewer/quitting-method-alist
  134.           'gnus-original-article-mode
  135.           (function mime-viewer/quitting-method-for-gnus))
  136.    
  137.    (set-alist 'mime-viewer/show-summary-method
  138.           'gnus-original-article-mode
  139.           (function mime-viewer/quitting-method-for-gnus))
  140.    ))
  141.  
  142.  
  143. ;;; @ for BBDB
  144. ;;;
  145.  
  146. (call-after-loaded
  147.  'bbdb
  148.  (function
  149.   (lambda ()
  150.     (require 'tm-bbdb)
  151.     )))
  152.  
  153. (autoload 'tm-bbdb/update-record "tm-bbdb")
  154.  
  155. (defun tm-gnus/bbdb-setup ()
  156.   (if (and (boundp 'gnus-article-prepare-hook)
  157.        (memq 'bbdb/gnus-update-record gnus-article-prepare-hook)
  158.        )
  159.       (progn
  160.     (remove-hook 'gnus-article-prepare-hook 'bbdb/gnus-update-record)
  161.     (add-hook 'gnus-article-display-hook 'tm-bbdb/update-record)
  162.     )))
  163.  
  164. (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
  165.  
  166. (tm-gnus/bbdb-setup)
  167.  
  168.  
  169. ;;; @ end
  170. ;;;
  171.  
  172. (provide 'gnus-art-mime)
  173.  
  174. ;;; gnus-art-mime.el ends here
  175.